Daily Exercise 21

Time Series Practice

Downloading USGS data

Attaching package: 'dplyr'

The following objects are masked from 'package:stats':

    filter, lag

The following objects are masked from 'package:base':

    intersect, setdiff, setequal, union

Attaching package: 'lubridate'

The following objects are masked from 'package:base':

    date, intersect, setdiff, union

Loading required package: ggplot2

Attaching package: 'plotly'

The following object is masked from 'package:ggplot2':

    last_plot

The following object is masked from 'package:stats':

    filter

The following object is masked from 'package:graphics':

    layout

── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ forcats 1.0.0     ✔ stringr 1.5.1
✔ purrr   1.0.4     ✔ tibble  3.2.1
✔ readr   2.1.5     
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ plotly::filter() masks dplyr::filter(), stats::filter()
✖ dplyr::lag()     masks stats::lag()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

Attaching package: 'zoo'


The following objects are masked from 'package:base':

    as.Date, as.Date.numeric


Loading required package: fabletools

Registered S3 method overwritten by 'tsibble':
  method               from 
  as_tibble.grouped_df dplyr


Attaching package: 'tsibble'


The following object is masked from 'package:zoo':

    index


The following object is masked from 'package:lubridate':

    interval


The following objects are masked from 'package:base':

    intersect, setdiff, union


GET:https://waterservices.usgs.gov/nwis/dv/?site=06752260&format=waterml%2C1.1&ParameterCd=00060&StatCd=00003&startDT=2013-01-01&endDT=2023-12-31

1. Convert to tsibble

poudre_flow <- as_tsibble(poudre_flow)

Using `Date` as index variable.

head(poudre_flow)

# A tsibble: 6 x 2 [1M]
      Date   Flow
     <mth>  <dbl>
1 2013 Jan  18.1 
2 2013 Feb  18.0 
3 2013 Mar   8.21
4 2013 Apr   5.94
5 2013 May 333.  
6 2013 Jun 300.  

2. Plotting time series

poudre_plot <- ggscatter(poudre_flow, x = "Date", y = "Flow")+
  geom_line(alpha = 0.5)

ggplotly(poudre_plot)

3. Subseries

gg_subseries(poudre_flow) +
  labs(title = "Seasonal Poudre Flow Patterns",
       y = "Average Flow",
       x = "Date (Year)") +
  theme_minimal()

Plot variable not specified, automatically selected `y = Flow`

gg_season(poudre_flow)+
  labs(title = "Seasonal Poudre Flow Patterns",
       y = "Average Flow",
       x = "Month")

Plot variable not specified, automatically selected `y = Flow`

Answer to Question 3

In this graphic, seasons are defined by the month. A subseries is the history of each month plotted through multiple years.

Decomposing the Data

poudre_decomp <- poudre_flow |>
  model(STL(Flow ~ season(window = "periodic"))) |>
  components()

glimpse(poudre_decomp)

Rows: 132
Columns: 7
Key: .model [1]
: Flow = trend + season_year + remainder
$ .model        <chr> "STL(Flow ~ season(window = \"periodic\"))", "STL(Flow ~…
$ Date          <mth> 2013 Jan, 2013 Feb, 2013 Mar, 2013 Apr, 2013 May, 2013 J…
$ Flow          <dbl> 18.125806, 18.046429, 8.208710, 5.940667, 332.579677, 29…
$ trend         <dbl> 13.00888, 41.96281, 70.91675, 100.76013, 130.60351, 157.…
$ season_year   <dbl> -173.45913, -175.84378, -177.67642, -121.33463, 640.8778…
$ remainder     <dbl> 178.57606, 151.92740, 114.96839, 26.51517, -438.90172, -…
$ season_adjust <dbl> 191.5849, 193.8902, 185.8851, 127.2753, -308.2982, -478.…

poudre_trend <- ggscatter(poudre_decomp, y = "trend", x = "Date")

poudre_season <- ggscatter(poudre_decomp, y = "season_year", x = "Date")

Answer 4.

What I see is a gradual decrease in the Poudre’s flow like a bear market trend. This could be reflective of increasing pressures on the Poudre watershed in the last decade from development and drought. Plotting season_year, trends are removed through time to just reveal seasonal patterns. With this graph, the patterns are very symmetrical, suggesting that season has a predicatble influence on river flow and there are other factors at play outside of season.